home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / morris / aboutbox.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-11-15  |  14.4 KB  |  397 lines
  1. VERSION 2.00
  2. Begin Form frmAboutBox 
  3.    BackColor       =   &H8000000F&
  4.    BorderStyle     =   3  'Fixed Double
  5.    ClientHeight    =   3180
  6.    ClientLeft      =   2160
  7.    ClientTop       =   2328
  8.    ClientWidth     =   5256
  9.    Height          =   3600
  10.    Icon            =   ABOUTBOX.FRX:0000
  11.    Left            =   2112
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3180
  16.    ScaleWidth      =   5256
  17.    Top             =   1956
  18.    Width           =   5352
  19.    Begin PictureBox picIcon 
  20.       BackColor       =   &H8000000F&
  21.       Height          =   492
  22.       Left            =   120
  23.       ScaleHeight     =   468
  24.       ScaleWidth      =   468
  25.       TabIndex        =   9
  26.       Top             =   72
  27.       Width           =   492
  28.    End
  29.    Begin CommandButton cmdFullSysInfo 
  30.       BackColor       =   &H8000000F&
  31.       Caption         =   "&System Info..."
  32.       FontBold        =   0   'False
  33.       FontItalic      =   0   'False
  34.       FontName        =   "MS Sans Serif"
  35.       FontSize        =   7.8
  36.       FontStrikethru  =   0   'False
  37.       FontUnderline   =   0   'False
  38.       Height          =   384
  39.       Left            =   3816
  40.       TabIndex        =   7
  41.       Top             =   1236
  42.       Width           =   1344
  43.    End
  44.    Begin CommandButton cmdOK 
  45.       BackColor       =   &H8000000F&
  46.       Cancel          =   -1  'True
  47.       Caption         =   "OK"
  48.       Default         =   -1  'True
  49.       FontBold        =   0   'False
  50.       FontItalic      =   0   'False
  51.       FontName        =   "MS Sans Serif"
  52.       FontSize        =   7.8
  53.       FontStrikethru  =   0   'False
  54.       FontUnderline   =   0   'False
  55.       Height          =   384
  56.       Left            =   3816
  57.       TabIndex        =   6
  58.       Top             =   840
  59.       Width           =   1344
  60.    End
  61.    Begin Label lblCompany 
  62.       AutoSize        =   -1  'True
  63.       BackColor       =   &H8000000F&
  64.       BackStyle       =   0  'Transparent
  65.       BorderStyle     =   1  'Fixed Single
  66.       Caption         =   "Company"
  67.       FontBold        =   0   'False
  68.       FontItalic      =   0   'False
  69.       FontName        =   "MS Sans Serif"
  70.       FontSize        =   7.8
  71.       FontStrikethru  =   0   'False
  72.       FontUnderline   =   0   'False
  73.       Height          =   216
  74.       Left            =   168
  75.       TabIndex        =   1
  76.       Top             =   1188
  77.       Width           =   720
  78.    End
  79.    Begin Label lblName 
  80.       AutoSize        =   -1  'True
  81.       BackColor       =   &H8000000F&
  82.       BackStyle       =   0  'Transparent
  83.       BorderStyle     =   1  'Fixed Single
  84.       Caption         =   "Name"
  85.       FontBold        =   0   'False
  86.       FontItalic      =   0   'False
  87.       FontName        =   "MS Sans Serif"
  88.       FontSize        =   7.8
  89.       FontStrikethru  =   0   'False
  90.       FontUnderline   =   0   'False
  91.       Height          =   216
  92.       Left            =   180
  93.       TabIndex        =   2
  94.       Top             =   912
  95.       Width           =   468
  96.    End
  97.    Begin Label lblProductID 
  98.       AutoSize        =   -1  'True
  99.       BackColor       =   &H8000000F&
  100.       BackStyle       =   0  'Transparent
  101.       BorderStyle     =   1  'Fixed Single
  102.       Caption         =   "2656-6767-8080"
  103.       FontBold        =   0   'False
  104.       FontItalic      =   0   'False
  105.       FontName        =   "MS Sans Serif"
  106.       FontSize        =   7.8
  107.       FontStrikethru  =   0   'False
  108.       FontUnderline   =   0   'False
  109.       Height          =   216
  110.       Left            =   1068
  111.       TabIndex        =   3
  112.       Top             =   1452
  113.       Width           =   1128
  114.    End
  115.    Begin Label lblDummy1 
  116.       AutoSize        =   -1  'True
  117.       BackColor       =   &H8000000F&
  118.       BackStyle       =   0  'Transparent
  119.       BorderStyle     =   1  'Fixed Single
  120.       Caption         =   "Product ID:"
  121.       FontBold        =   0   'False
  122.       FontItalic      =   0   'False
  123.       FontName        =   "MS Sans Serif"
  124.       FontSize        =   7.8
  125.       FontStrikethru  =   0   'False
  126.       FontUnderline   =   0   'False
  127.       Height          =   216
  128.       Left            =   168
  129.       TabIndex        =   4
  130.       Top             =   1452
  131.       Width           =   804
  132.    End
  133.    Begin Shape Shape1 
  134.       BorderColor     =   &H00000000&
  135.       Height          =   972
  136.       Left            =   120
  137.       Top             =   840
  138.       Width           =   3612
  139.    End
  140.    Begin Label lblCaption 
  141.       AutoSize        =   -1  'True
  142.       BackStyle       =   0  'Transparent
  143.       BorderStyle     =   1  'Fixed Single
  144.       Caption         =   "Caption Text"
  145.       FontBold        =   0   'False
  146.       FontItalic      =   0   'False
  147.       FontName        =   "MS Sans Serif"
  148.       FontSize        =   7.8
  149.       FontStrikethru  =   0   'False
  150.       FontUnderline   =   0   'False
  151.       Height          =   216
  152.       Left            =   696
  153.       TabIndex        =   8
  154.       Top             =   84
  155.       Width           =   924
  156.    End
  157.    Begin Line ln3D2 
  158.       BorderColor     =   &H00FFFFFF&
  159.       X1              =   192
  160.       X2              =   5040
  161.       Y1              =   1920
  162.       Y2              =   1920
  163.    End
  164.    Begin Line ln3D1 
  165.       BorderColor     =   &H00000000&
  166.       X1              =   192
  167.       X2              =   5040
  168.       Y1              =   1908
  169.       Y2              =   1908
  170.    End
  171.    Begin Label lblCopyright 
  172.       AutoSize        =   -1  'True
  173.       BackStyle       =   0  'Transparent
  174.       Caption         =   "Warning: This computer program is protected by copyright law and International treaties. Unauthorized reproduction or distribution of this program, or any portion of it, may result in severe civil and criminal penalties, and will be prosecuted to the maximum extent possible under the law."
  175.       FontBold        =   0   'False
  176.       FontItalic      =   0   'False
  177.       FontName        =   "MS Sans Serif"
  178.       FontSize        =   7.8
  179.       FontStrikethru  =   0   'False
  180.       FontUnderline   =   0   'False
  181.       Height          =   1116
  182.       Left            =   36
  183.       TabIndex        =   5
  184.       Top             =   2016
  185.       Width           =   5172
  186.       WordWrap        =   -1  'True
  187.    End
  188.    Begin Label lblLicensedTo 
  189.       AutoSize        =   -1  'True
  190.       BackStyle       =   0  'Transparent
  191.       Caption         =   "This product is licensed to:"
  192.       Height          =   192
  193.       Left            =   120
  194.       TabIndex        =   0
  195.       Top             =   624
  196.       Width           =   2244
  197.    End
  198.    Begin Shape Shape2 
  199.       BorderColor     =   &H00FFFFFF&
  200.       Height          =   972
  201.       Left            =   132
  202.       Top             =   852
  203.       Width           =   3612
  204.    End
  205. '==========================================================
  206. '    Module - ABOUTBOX.FRM
  207. '    Module Prefix - None
  208. '    Author - Peter J. Morris. TMS Ltd.
  209. '    Date Written : #### Date - 16/11/94    Time - 03:11
  210. '    Purpose - First About Box form, standard about box
  211. '              minus system detail.
  212. '    Revisions
  213. '    BY            WHY            AFFECTED
  214. '    Peter J. Morris. TMS Ltd. Original code.
  215. '==========================================================
  216. Option Explicit
  217. '==========================================================
  218. '    Function - cmdFullSysInfo_Click
  219. '    Author - Peter J. Morris. TMS Ltd.
  220. '    Date Written: #### Date - 16/11/94    Time - 03:11
  221. '    Purpose - See function purpose.
  222. '    Revisions:
  223. '    BY            WHY            AFFECTED
  224. '    Peter J. Morris. TMS Ltd. Original code.
  225. '    INPUTS -  None
  226. '    OUTPUTS - None
  227. '==========================================================
  228. Private Sub cmdFullSysInfo_Click ()
  229. '==========================================================
  230. '    Form: ABOUTBOX.FRM Procedure: cmdFullSysInfo_Click
  231. '    Author - Peter J. Morris. TMS Ltd.
  232. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  233. '    Copyright and status if any: Copyright 
  234.  TMS 1994,1995
  235. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  236. '    Purpose/Description In brief:
  237. '    Shows 'main' dialog.
  238. '=========================================================
  239. ' Set up general error handler
  240. On Error GoTo Error_cmdFullSysInfo_Click:
  241.     ' ========== Code Starts.==========
  242.     Screen.MousePointer = HOURGLASS
  243.     ' Show 'full' system info form to user modally. This is the form
  244.     ' that contains most of the fruity information.
  245.     frmAboutBoxInfo.Show MODAL
  246.     ' ========== Code Ends  .==========
  247.     Exit Sub
  248. ' Error handler
  249. Error_cmdFullSysInfo_Click:
  250.     ' Set pointer back first.
  251.     Screen.MousePointer = DEFAULT
  252.     ' Call general error handler
  253.     ErrorHandler "ABOUTBOX.FRM/cmdFullSysInfo_Click", Err, Error$
  254.     ' Default resume behaviour: exit this sub/func
  255.     Resume Exit_cmdFullSysInfo_Click:
  256. Exit_cmdFullSysInfo_Click:
  257. End Sub
  258. '==========================================================
  259. '    Function - cmdOK_Click
  260. '    Author - Peter J. Morris. TMS Ltd.
  261. '    Date Written: #### Date - 16/11/94    Time - 03:11
  262. '    Purpose - See function purpose.
  263. '    Revisions:
  264. '    BY            WHY            AFFECTED
  265. '    Peter J. Morris. TMS Ltd. Original code.
  266. '    INPUTS -  None
  267. '    OUTPUTS - None
  268. '==========================================================
  269. Private Sub cmdOK_Click ()
  270. '==========================================================
  271. '    Form: ABOUTBOX.FRM Procedure: cmdOK_Click
  272. '    Author - Peter J. Morris. TMS Ltd.
  273. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  274. '    Copyright and status if any: Copyright 
  275.  TMS 1994,1995
  276. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  277. '    Purpose/Description In brief:
  278. '    Unloads form.
  279. '=========================================================
  280. ' Set up general error handler
  281. On Error GoTo Error_cmdOK_Click:
  282.     ' ========== Code Starts.==========
  283.     '// Simply unload form on click of OK button.
  284.     Unload Me
  285.     ' ========== Code Ends  .==========
  286.     Exit Sub
  287. ' Error handler
  288. Error_cmdOK_Click:
  289.     ' Call general error handler
  290.     ErrorHandler "ABOUTBOX.FRM/cmdOK_Click", Err, Error$
  291.     ' Default resume behaviour: exit this sub/func
  292.     Resume Exit_cmdOK_Click:
  293. Exit_cmdOK_Click:
  294. End Sub
  295. '==========================================================
  296. '    Function - DoIcon
  297. '    Author - Peter J. Morris. TMS Ltd.
  298. '    Date Written: #### Date - 16/11/94    Time - 03:11
  299. '    Purpose - See function purpose.
  300. '    Revisions:
  301. '    BY            WHY            AFFECTED
  302. '    Peter J. Morris. TMS Ltd. Original code.
  303. '    INPUTS -  frm -> Form to use.
  304. '    OUTPUTS - None
  305. '==========================================================
  306. Private Sub DoIcon (frm As Form)
  307. '==========================================================
  308. '    Form: ABOUTBOX.FRM Procedure: DoIcon
  309. '    Author - Peter J. Morris. TMS Ltd.
  310. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  311. '    Copyright and status if any: Copyright 
  312.  TMS 1994,1995
  313. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  314. '    Purpose/Description In brief:
  315. '    Sub to update our picture box (picIcon) with the main icon
  316. '    from our executable.  This allows this 'About Box' code to
  317. '    be a little more generic therefore.
  318. '=========================================================
  319. ' Set up general error handler
  320. On Error GoTo Error_DoIcon:
  321.     ' ========== Code Starts.==========
  322.     ' Holds app's icon handle.
  323.     Dim hIcon As Integer
  324.     ' Turn off picture boxes border.
  325.     frm!picIcon.BorderStyle = 0
  326.     ' Make sure picture box can hold an icon EXACTLY.
  327.     frm!picIcon.AutoSize = True
  328.     frm!picIcon.Picture = Me.Icon
  329.     ' Get icon out of EXE. Could have used GetModuleFileName() here. Assume
  330.     ' that 0 is a good index for the default icon as it usually is.
  331.     hIcon = ExtractIcon(GetWindowWord(Me.hWnd, GWW_HINSTANCE), App.Path & "\" & App.EXEName & ".EXE", 0)
  332.     ' Di we get a real icon?
  333.     If hIcon <> 0 Then
  334.         ' Render if found.
  335.         g_vDummy = DrawIcon(frm!picIcon.hDC, 0, 0, hIcon)
  336.     Else
  337.         ' Create off-screen image so that picture alwats redraws OK.
  338.         frm!picIcon.AutoRedraw = True
  339.         frm!picIcon.Picture = Me.Icon
  340.         frm!picIcon.Refresh
  341.     End If
  342.     ' ========== Code Ends  .==========
  343.     Exit Sub
  344. ' Error handler
  345. Error_DoIcon:
  346.     ' Call general error handler
  347.     ErrorHandler "ABOUTBOX.FRM/DoIcon", Err, Error$
  348.     ' Default resume behaviour: exit this sub/func
  349.     Resume Exit_DoIcon:
  350. Exit_DoIcon:
  351. End Sub
  352. '==========================================================
  353. '    Function - Form_Load
  354. '    Author - Peter J. Morris. TMS Ltd.
  355. '    Date Written: #### Date - 16/11/94    Time - 03:11
  356. '    Purpose - See function purpose.
  357. '    Revisions:
  358. '    BY            WHY            AFFECTED
  359. '    Peter J. Morris. TMS Ltd. Original code.
  360. '    INPUTS -  None
  361. '    OUTPUTS - None
  362. '==========================================================
  363. Private Sub Form_Load ()
  364. '==========================================================
  365. '    Form: ABOUTBOX.FRM Procedure: Form_Load
  366. '    Author - Peter J. Morris. TMS Ltd.
  367. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  368. '    Copyright and status if any: Copyright 
  369.  TMS 1994,1995
  370. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  371. '    Purpose/Description In brief:
  372. '    Simple form initialisation.
  373. '=========================================================
  374. ' Set up general error handler
  375. On Error GoTo Error_Form_Load:
  376.     ' ========== Code Starts.==========
  377.     ' Center the form.
  378.     CenterWindow Me
  379.     ' Update the captions (form.caption and caption label) and
  380.     ' get registration information from Windows.
  381.     DoCaption Me
  382.     DoRegInfo Me
  383.     ' Update about box icon with application's icon.
  384.     DoIcon Me
  385.     ' Re-init label controls.
  386.     DoLabels Me
  387.     ' ========== Code Ends  .==========
  388.     Exit Sub
  389. ' Error handler
  390. Error_Form_Load:
  391.     ' Call general error handler
  392.     ErrorHandler "ABOUTBOX.FRM/Form_Load", Err, Error$
  393.     ' Default resume behaviour: exit this sub/func
  394.     Resume Exit_Form_Load:
  395. Exit_Form_Load:
  396. End Sub
  397.